home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibt3sp1.arc / ADJUSTFN.PAS next >
Pascal/Delphi Source File  |  1985-10-03  |  4KB  |  100 lines
  1. (*----------------------------------------------------------------------*)
  2. (*           Adjust_FN --- Adjust file name of incoming file            *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Adjust_FN(     FileRef  : AnyStr;
  6.                      VAR Drive    : AnyStr;
  7.                      VAR FileName : AnyStr;
  8.                      VAR FileType : AnyStr  );
  9.  
  10. (*----------------------------------------------------------------------*)
  11. (*                                                                      *)
  12. (*     Procedure:  Adjust_FN                                            *)
  13. (*                                                                      *)
  14. (*     Purpose:    Adjust file name of incoming file for Kermit         *)
  15. (*                                                                      *)
  16. (*     Calling Sequence:                                                *)
  17. (*                                                                      *)
  18. (*                                                                      *)
  19. (*        Adjust_FN(     FileRef  : AnyStr;                             *)
  20. (*                   VAR Drive    : AnyStr;                             *)
  21. (*                   VAR FileName : AnyStr;                             *)
  22. (*                   VAR FileType : AnyStr  );                          *)
  23. (*                                                                      *)
  24. (*     Remarks:                                                         *)
  25. (*                                                                      *)
  26. (*        This routine prevents an existing file from being overwritten *)
  27. (*        by changing the file name.                                    *)
  28. (*                                                                      *)
  29. (*----------------------------------------------------------------------*)
  30.  
  31. VAR
  32.    Insert_Pos : INTEGER;
  33.    Count      : INTEGER;
  34.  
  35. BEGIN (* Adjust_FN *)
  36.  
  37.    FOR Count := 1 TO LENGTH( FileRef ) DO
  38.       IF ( FileRef[Count] IN ['a'..'z'] ) THEN
  39.          FileRef[Count] := CHR( ORD( FileRef[Count] ) AND $DF );
  40.  
  41.    IF ( POS('.', FileRef) <> 0 ) THEN
  42.       BEGIN
  43.          FileName := COPY( FileRef, 1, POS('.', FileRef) - 1 );
  44.          FileType := COPY( FileRef, POS('.', FileRef) + 1, 3 );
  45.       END
  46.    ELSE
  47.       BEGIN
  48.          FileName := FileRef;
  49.          FileType := '';
  50.       END;
  51.  
  52.    IF ( POS(':', FileName) <> 0 ) THEN
  53.       BEGIN
  54.  
  55.          Drive := COPY( FileName, 1, POS(':', FileName) - 1 );
  56.  
  57.          DELETE( FileName, 1, POS(':', FileName) );
  58.  
  59.          IF ( FileName = '' ) THEN
  60.             BEGIN
  61.                FileName := '*';
  62.                FileType := '*';
  63.             END;
  64.  
  65.       END
  66.    ELSE
  67.       Drive := '!';
  68.  
  69.    WHILE ( POS('*',FileName) <> 0 ) DO
  70.       BEGIN
  71.  
  72.          Insert_Pos := POS('*', FileName);
  73.  
  74.          DELETE( FileName, Insert_Pos, 1 );
  75.  
  76.          WHILE ( LENGTH(FileName) < 8 ) DO
  77.             INSERT( '?', FileName, Insert_Pos );
  78.  
  79.       END;
  80.  
  81.    WHILE ( POS('*',FileType) <> 0 ) DO
  82.       BEGIN
  83.  
  84.          Insert_Pos := POS('*', FileType);
  85.  
  86.          DELETE( FileType, Insert_Pos, 1 );
  87.  
  88.          WHILE ( LENGTH(FileType) < 3 ) DO
  89.             INSERT( '?', FileType, Insert_Pos );
  90.  
  91.       END;
  92.  
  93.    WHILE ( LENGTH(FileName) < 8 ) DO
  94.       FileName := FileName + ' ';
  95.  
  96.    WHILE ( LENGTH(FileType) < 3 ) DO
  97.       FileType := FileType + ' ';
  98.  
  99. END    (* Adjust_FN *);
  100.